Como estudiantes de universidad y futuros agentes de cambio en nuestra área de estudio, debemos prepararnos no solo de manera académica, sino también en lo que concierne al cuidado personal y la salud siendo de vital importancia tener buenos hábitos alimenticios para tener una vida plena y sana. Sin embargo la escasez de información y un desinterés por mantener un buen consumo alimenticio.
Se recolectaron datos nutrimentales de un estudiante de universidad de primer semestre durante aproximadamente 11 semanas donde se registró el contenido calórico, carbohidratos, proteínas, lípidos(Grasas) y el sodio de cada alimento consumido por este periodo de tiempo, para que de esta manera podamos predecir el contenido calórico de un alimento en relación a cada grupo de macronutrientes que este contenga.
De la misma manera, el presente estudio pretende establecer una predicción del contenido calórico de un alimento en base a los macronutrientes de este mismo, con base a los que más aportan a este rubro. Es decir buscar qué macronutriente aporta más al aumento del contenido calórico.
Como mencionamos anteriormente, el tener una dieta sana es de suma importancia para el cuidado personal, sin embargo no es tan sencillo tomar decisiones sin un conocimiento o con escasa información. Se pretende que este estudio ayude al usuario a tomar decisiones sobre su consumo alimenticio y así aportar a mejorar su dieta.
El presente informe se realizó utilizando las herramientas de Quarto para la realización del reporte y el lenguaje de programación de R para el análisis de los datos obtenidos. Fue dividido en 4 secciones principales con el fin de facilitar su lectura al usuario. A continuación se da un resumen rápido de todas las secciones.
Análisis exploratorio: En esta sección tiene el fin de conocer y comprender cómo se comportan los datos que tenemos de manera general.
Análisis por variable: Analizamos el comportamiento de las variables respecto al contenido calórico, así como un modelo de regresión lineal simple para analizar la relación de las variables con respecto al contenido calórico de los alimentos. Así como una comparativa del comportamiento de todas las variables.
Modelos de predicción para calorías: Utilizando todas las variables, ajustamos diferentes modelos con el fin de encontrar un modelo que se adapte de mejor manera a los datos obtenidos y de esta manera poder realizar predicciones del contenido calórico.
Predicciones: Utilizando los modelos de predicción anteriores, realizamos una predicción con algunos datos preestablecidos para conocer el contenido calórico de cualquier alimento.
library(tidyverse)
library(tidymodels)
library(ggplot2)
library(plotly)
library(RColorBrewer)
library(vip)
library(knitr)
library(rmarkdown)
nutri <- read_csv("A01735612_registroNutrimental-tabla.csv")
paged_table(nutri, options = list(rows.print = 10, cols.print = 9))Vista previa de los datos
Convertimos todos los caracteres como factores, para poder operarlos.
#Convertimso caracteres a factor
nutri %>% mutate(across(where(is.character), as_factor))En la siguiente tabla apreciamos las diferentes tipos de alimentos consumidos en total durante el registro de los datos junto con sus propiedades.
#Obtenemos las columans que deseamos separar
separa <- nutri %>%
select(alimento,
contenido_calorico,
carbohidratos,
proteinas,
lipidos,
sodio) %>% na.omit()
aliemntos <- separa %>% # Esta variable la utilizaremos para usar el top
distinct()
paged_table(aliemntos, options = list(rows.print = 10, cols.print = 6))Todos los alimentos presentes
Analizamos el promedio de calorias, carbohidratos, proteinas, grasas y sodio totales.
#Obtenemso el premdio de nuestaras variables
valores_medios <- nutri %>%
summarize(calorias = mean(contenido_calorico), # Media calorias
carbohidratos = mean(carbohidratos, na.rm = TRUE), # Media carbohidratos
proteinas = mean(proteinas, na.rm = TRUE), # Media proteinas
grasas = mean(lipidos, na.rm = TRUE), # Media grasas
sodio = mean(sodio, na.rm = TRUE)) # Media sodio
valores_medios %>%
kable(digits = 3,
format.args = list(big.mark = ",")) #Lo mostramos en una tabla| calorias | carbohidratos | proteinas | grasas | sodio |
|---|---|---|---|---|
| 225.932 | 21.579 | 11.036 | 28.724 | 454.764 |
Promedio total de todos los datos recopilados
En la siguiente sección, se presentarán los resúmenes estadísticos de cada columna, es decir obtenemos el valor mínimo, el máximo, el promedio y la mediana de cada columna del total de datos recopilados.
calos <- nutri %>%
select(contenido_calorico) %>%
summarize(Minimo = min(contenido_calorico),
Promedio = mean(contenido_calorico),
Mediana = median(contenido_calorico),
Maximo = max(contenido_calorico))
calos %>%
kable(digits = 3,
format.args = list(big.mark = ","))| Minimo | Promedio | Mediana | Maximo |
|---|---|---|---|
| 26 | 225.932 | 199 | 1,060 |
Analisis Estadistico de Calorias
carbo <- nutri %>%
select(carbohidratos) %>%
summarize(Minimo = min(carbohidratos, na.rm = TRUE),
Promedio = mean(carbohidratos, na.rm = TRUE),
Mediana = median(carbohidratos, na.rm = TRUE),
Maximo = max(carbohidratos, na.rm = TRUE))
carbo %>%
kable(digits = 3,
format.args = list(big.mark = ","))| Minimo | Promedio | Mediana | Maximo |
|---|---|---|---|
| 0 | 21.579 | 20 | 81 |
Analisis Estadistico de carbohidratos
prote <- nutri %>%
select(proteinas) %>%
summarize(Minimo = min(proteinas),
Promedio = mean(proteinas),
Mediana = median(proteinas),
Maximo = max(proteinas))
prote %>%
kable(digits = 3,
format.args = list(big.mark = ","))| Minimo | Promedio | Mediana | Maximo |
|---|---|---|---|
| 0 | 11.036 | 6 | 293 |
Analisis Estadistico de proteinas
grasa <- nutri %>%
select(lipidos) %>%
summarize(Minimo = min(lipidos, na.rm = TRUE),
Promedio = mean(lipidos, na.rm = TRUE),
Mediana = median(lipidos, na.rm = TRUE),
Maximo = max(lipidos, na.rm = TRUE))
grasa %>%
kable(digits = 3,
format.args = list(big.mark = ","))| Minimo | Promedio | Mediana | Maximo |
|---|---|---|---|
| 0 | 28.724 | 6.78 | 250 |
Analisis Estadistico de lipidos
sod <- nutri %>%
select(sodio) %>%
summarize(Minimo = min(sodio),
Promedio = mean(sodio),
Mediana = median(sodio),
Maximo = max(sodio))
sod %>%
kable(digits = 3,
format.args = list(big.mark = ","))| Minimo | Promedio | Mediana | Maximo |
|---|---|---|---|
| 0 | 454.764 | 210 | 2,300 |
Analisis Estadistico de sodio
Como parte de nuestro análisis, realizamos un top 10 de los alimentos que contienen más de cada microalimento.
cal <- aliemntos %>%
select(alimento, contenido_calorico) %>% #Sepramso losa liemtos y las calorias
slice_max(order_by = contenido_calorico, n = 10) #HAcemos el top 10
cal %>%
kable(digits = 3,
format.args = list(big.mark = ",")) #Lo mostramos en una tabla| alimento | contenido_calorico |
|---|---|
| double western bacon | 1,060 |
| Costillas de cerdo | 960 |
| sushi | 830 |
| tacos de carne | 570 |
| torta cubana | 558 |
| pizza | 488 |
| chilaquiles | 443 |
| flautas | 420 |
| pan dulce | 400 |
| pozole | 365 |
car <- aliemntos %>%
select(alimento, carbohidratos) %>%
slice_max(order_by = carbohidratos, n = 10)
car %>%
kable(digits = 3,
format.args = list(big.mark = ","))| alimento | carbohidratos |
|---|---|
| double western bacon | 81 |
| spaghetti rojo | 75 |
| pizza | 72 |
| torta de discada | 63 |
| torta cubana | 55 |
| pan dulce | 48 |
| Lasagna | 42 |
| lasgna | 42 |
| tacos de carne | 42 |
| papas fritas | 41 |
Top 10 aliemntos con mas Carbohidratos
protes <- aliemntos %>%
select(alimento, proteinas) %>%
slice_max(order_by = proteinas, n = 10)
protes %>%
kable(digits = 3,
format.args = list(big.mark = ","))| alimento | proteinas |
|---|---|
| pollo asado | 293.00 |
| double western bacon | 58.00 |
| picadillo | 32.20 |
| torta cubana | 31.00 |
| pizza | 28.00 |
| milanesa | 27.27 |
| tacos de carne | 27.00 |
| Sandwich | 23.00 |
| sandwich | 23.00 |
| gringa | 23.00 |
Top 10 aliemntos con mas proteinas
lip <- aliemntos %>%
select(alimento, lipidos) %>%
slice_max(order_by = lipidos, n = 10)
lip %>%
kable(digits = 3,
format.args = list(big.mark = ","))| alimento | lipidos |
|---|---|
| quesadilla | 250.00 |
| Quesadilla | 250.00 |
| pollo asado | 123.00 |
| double western bacon | 57.00 |
| tacos de carne | 33.00 |
| chilaquiles | 32.02 |
| gringa | 26.00 |
| carne de cerdo | 25.00 |
| torta cubana | 24.00 |
| flautas | 22.00 |
Top 10 aliemntos con mas grasa
sod <- aliemntos %>%
select(alimento, sodio) %>%
slice_max(order_by = sodio, n = 10)
sod %>%
kable(digits = 3,
format.args = list(big.mark = ","))| alimento | sodio |
|---|---|
| alitas de pollo | 2,300 |
| torta de discada | 2,300 |
| chilaquiles | 2,300 |
| cereal | 2,160 |
| double western bacon | 2,080 |
| pasta a la mantequilla | 2,000 |
| pasta a la bolgensa | 1,932 |
| tacos dorados | 1,924 |
| pizza | 1,890 |
| pozole | 1,418 |
Top 10 aliemntos con mas Sodio
Para realizar la comprobación de variables, ajustaremos una regresión lineal para cada variable respecto a las calorías
#Entrenamos el modelo
nutri_split <- initial_split(separa, strata = contenido_calorico)
#Declaramos los datos para entrenamiento
nutri_train <- nutri_split %>% training()
ntru_test <- nutri_split %>% testing()Una vez obtenida la receta podemos realizar las operaciones que deseemos, en este caso realizaremos una regresión lineal por cada columna de tal manera que podamos utilizar esta receta para todos los casos.
receta <- recipe(contenido_calorico ~ ., data = nutri_train) %>% #Asigna los roles correspodientes. CON TODAS LAS VARIABLES
step_other(alimento,threshold = 0.15) %>% #Los aprametros siguienets son necesarios para los mdoelos KKNN
step_nzv(all_predictors()) %>%
step_dummy(all_nominal_predictors()) %>%
step_normalize(all_numeric_predictors())Antes de realizar con profundidad los datos, podemos realizar una pequeña aproximación de lo que podemos obtener los datos, para esto utilizaremos la receta creada y lo pondremos en un gráfico.
prepros <- prep(receta) %>% bake(new_data = NULL) %>%
corrr::correlate() %>%
corrr::focus(contenido_calorico) %>%
ggplot(aes(x = contenido_calorico, y = fct_reorder(term, contenido_calorico),
fill = contenido_calorico > 0)) +
geom_col()
ggplotly(prepros)Relacion Calorias con las demas columnas
Como podemos apreciar en la gráfica, vemos una relación directa entre que, a amyor carbohidratos, mayor calorías, sin embargo es de vital importancia no quedarnos solo con esta información sin una comprobación, para ello realizaremos una regresión lineal simple por cada variable.
data_carbo <- separa %>% select(contenido_calorico, carbohidratos)carbo_split <- initial_split(data_carbo) #Divide los datos en 3/4
# Asiganmos los verdadreos y entrenamiento
carbo_train <- training(carbo_split) #Asignamso lo q entrenaremos
carbo_test <- testing(carbo_split) #Asigna la evaluacion
# Declaramos un modelo Lineal
lr_carbo <- linear_reg() %>%
set_engine('lm') %>%
set_mode('regression')
# Ajustamos el modelo
lr_fit_carbo <- lr_carbo %>%
fit(contenido_calorico ~ ., data = carbo_train) #entranamos el modelo
print(lr_fit_carbo) parsnip model object
Call:
stats::lm(formula = contenido_calorico ~ ., data = data)
Coefficients:
(Intercept) carbohidratos
64.474 7.335 En la siguiente sección podemos apreciar un resumen rápido del modelo, este nos sirve para tener una idea previa de los resultados que obtuvimos.
summary(lr_fit_carbo$fit) %>% print()
Call:
stats::lm(formula = contenido_calorico ~ ., data = data)
Residuals:
Min 1Q Median 3Q Max
-253.59 -76.20 -20.65 62.83 719.49
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 64.4743 13.9437 4.624 6.23e-06 ***
carbohidratos 7.3349 0.5063 14.486 < 2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 129.6 on 234 degrees of freedom
Multiple R-squared: 0.4728, Adjusted R-squared: 0.4705
F-statistic: 209.8 on 1 and 234 DF, p-value: < 2.2e-16lr_results_carbo <- carbo_test %>%
select(contenido_calorico) %>%
mutate(predict(lr_fit_carbo, new_data = carbo_test)) %>%
mutate(respecto = "carbohidratos")
paged_table(lr_results_carbo, options = list(rows.print = 10))Evaluacion del mdoelo lineal de carbohidratos
Las siguientes metrcias nos presentaran que tan bueno o que tan malo es el modelo
metricas_carbo <- metrics(lr_results_carbo, truth = contenido_calorico, estimate = .pred)
metricas_carbo %>% kable(digits = 3,
format.args = list(big.mark = ",")) #Lo mostramos en una tabla| .metric | .estimator | .estimate |
|---|---|---|
| rmse | standard | 128.729 |
| rsq | standard | 0.379 |
| mae | standard | 87.742 |
Metricas del modelo de carbohdratos
Coeficiente de determinación (RSQ): Nos indica que tan bueno es un modelo de predicción con valores entre 1 y 0. Siendo 0 muy malo y 1 muy bueno. Es importante mencionar que cada vez que se ejecute el código fuente del presente informe, estos valores cambiarán debido a que R toma diferentes valores cada vez que se ejecuta el script.
Distancia media cuadrática mínima (RMSE): Nos indica que tan bueno es un modelo de predicción, con al diferencia que este se da en valores numéricos reales de 0 a cualquier número donde x = 0 .Donde 0 es mejor y mientras más se aleje el valor del cero, menor será su nivel de predicción.
grafica_carbo <- lr_results_carbo %>%
ggplot(aes(x = .pred, y = contenido_calorico))+
geom_point(alpha = 0.1)+
geom_abline(color = "darkred")
ggplotly(grafica_carbo)Grafica del modelo lineal de carbohidratos
En la siguinte grafica podemos apreciar el comportamiento de los carbohidratos con la variable predicotra, es decir el contenido calorico,
data_prote <- separa %>% select(contenido_calorico, proteinas)prote_split <- initial_split(data_prote) #Divide los datos en 3/4
# Asiganmos los verdadreos y entrenamiento
prote_train <- training(prote_split) #Asignamso lo q entrenaremos
prote_test <- testing(prote_split) #Asigna la evaluacion
# Declaramos un modelo Lineal
lr_prote <- linear_reg() %>%
set_engine('lm') %>%
set_mode('regression')
# Ajustamos el modelo
lr_fit_prote <- lr_prote %>%
fit(contenido_calorico ~ ., data = prote_train) #entranamos el modelo
print(lr_fit_prote) parsnip model object
Call:
stats::lm(formula = contenido_calorico ~ ., data = data)
Coefficients:
(Intercept) proteinas
201.198 2.694 En la siguiente seccion podemos apreciar un resumen rapido del modelo, este nso sirve para tener una diea previa de los resulatdos que obtuvimos
summary(lr_fit_prote$fit) %>% print()
Call:
stats::lm(formula = contenido_calorico ~ ., data = data)
Residuals:
Min 1Q Median 3Q Max
-754.67 -91.61 -37.25 28.74 715.69
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 201.1978 13.0774 15.385 < 2e-16 ***
proteinas 2.6944 0.5405 4.985 1.2e-06 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 174 on 234 degrees of freedom
Multiple R-squared: 0.09602, Adjusted R-squared: 0.09215
F-statistic: 24.85 on 1 and 234 DF, p-value: 1.204e-06lr_results_prote <- prote_test %>%
select(contenido_calorico) %>%
mutate(predict(lr_fit_prote, new_data = prote_test)) %>%
mutate(respecto = "Proteinas")
paged_table(lr_results_prote, options = list(rows.print = 10))Evaluacion del mdoelo lineal de proteinas
Las siguientes metrcias nos presentaran que tan bueno o que tan malo es el modelo
metricas_prote <- metrics(lr_results_prote, truth = contenido_calorico, estimate = .pred)
metricas_prote %>% kable(digits = 3,
format.args = list(big.mark = ",")) #Lo mostramos en una tabla| .metric | .estimator | .estimate |
|---|---|---|
| rmse | standard | 128.122 |
| rsq | standard | 0.493 |
| mae | standard | 91.181 |
Metricas del modelo de proteinas
Coeficiente de determinación (RSQ): Nos indica que tan bueno es un modelo de predicción con valores entre 1 y 0. Siendo 0 muy malo y 1 muy bueno. Es importante mencionar que cada vez que se ejecute el código fuente del presente informe, estos valores cambiarán debido a que R toma diferentes valores cada vez que se ejecuta el script.
Distancia media cuadrática mínima (RMSE): Nos indica que tan bueno es un modelo de predicción, con al diferencia que este se da en valores numéricos reales de 0 a cualquier número donde x = 0 .Donde 0 es mejor y mientras más se aleje el valor del cero, menor será su nivel de predicción.
grafica_prote <- lr_results_prote %>%
ggplot(aes(x = .pred, y = contenido_calorico))+
geom_point(alpha = 0.1)+
geom_abline(color = "darkred")
ggplotly(grafica_prote)Grafica del modelo lineal de proteinas
Nuestra gráfica nos muestra de manera visual cómo se comporta el modelo (Lineal roja delgada) y como las variable se relacionan para este modelo, junto cona visualización del error que el modelo tiene.
data_lipidos <- separa %>% select(contenido_calorico, lipidos)lipidos_split <- initial_split(data_lipidos) #Divide los datos en 3/4
# Asiganmos los verdadreos y entrenamiento
lipidos_train <- training(lipidos_split) #Asignamso lo q entrenaremos
lipidos_test <- testing(lipidos_split) #Asigna la evaluacion
# Declaramos un modelo Lineal
lr_lipidos <- linear_reg() %>%
set_engine('lm') %>%
set_mode('regression')
# Ajustamos el modelo
lr_fit_lipidos <- lr_lipidos %>%
fit(contenido_calorico ~ ., data = lipidos_train) #entranamos el modelo
print(lr_fit_lipidos) parsnip model object
Call:
stats::lm(formula = contenido_calorico ~ ., data = data)
Coefficients:
(Intercept) lipidos
209.3256 0.4546 En la siguiente sección podemos apreciar un resumen rápido del modelo, este nos sirve para tener una idea previa de los resultados que obtuvimos
summary(lr_fit_lipidos$fit) %>% print()
Call:
stats::lm(formula = contenido_calorico ~ ., data = data)
Residuals:
Min 1Q Median 3Q Max
-183.46 -88.16 -48.98 21.36 824.76
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 209.3256 11.9703 17.487 <2e-16 ***
lipidos 0.4546 0.1585 2.869 0.0045 **
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 168.7 on 234 degrees of freedom
Multiple R-squared: 0.03397, Adjusted R-squared: 0.02984
F-statistic: 8.228 on 1 and 234 DF, p-value: 0.004501lr_results_lipidos <- lipidos_test %>%
select(contenido_calorico) %>%
mutate(predict(lr_fit_lipidos, new_data = lipidos_test)) %>%
mutate(respecto = "Grasas")
paged_table(lr_results_lipidos, options = list(rows.print = 10))Evaluacion del mdoelo lineal de lipidos
Las siguientes metrcias nos presentaran que tan bueno o que tan malo es el modelo
metricas_lipidos <- metrics(lr_results_lipidos, truth = contenido_calorico, estimate = .pred)
metricas_lipidos %>% kable(digits = 3,
format.args = list(big.mark = ",")) #Lo mostramos en una tabla| .metric | .estimator | .estimate |
|---|---|---|
| rmse | standard | 178.962 |
| rsq | standard | 0.032 |
| mae | standard | 104.937 |
Metricas del modelo de lipidos
Coeficiente de determinación (RSQ): Nos indica que tan bueno es un modelo de predicción con valores entre 1 y 0. Siendo 0 muy malo y 1 muy bueno. Es importante mencionar que cada vez que se ejecute el código fuente del presente informe, estos valores cambiarán debido a que R toma diferentes valores cada vez que se ejecuta el script.
Distancia media cuadrática mínima (RMSE): Nos indica que tan bueno es un modelo de predicción, con al diferencia que este se da en valores numéricos reales de 0 a cualquier número donde x = 0 .Donde 0 es mejor y mientras más se aleje el valor del cero, menor será su nivel de predicción.
grafica_lipidos <- lr_results_lipidos %>%
ggplot(aes(x = .pred, y = contenido_calorico))+
geom_point(alpha = 0.1)+
geom_abline(color = "darkred")
ggplotly(grafica_lipidos)Grafica del modelo lineal de lipidos
Nuestra gráfica nos muestra de manera visual cómo se comporta el modelo (Lineal roja delgada) y como las variable se relacionan para este modelo, junto cona visualización del error que el modelo tiene.
data_sodio <- separa %>% select(contenido_calorico, sodio)sodio_split <- initial_split(data_sodio) #Divide los datos en 3/4
# Asiganmos los verdadreos y entrenamiento
sodio_train <- training(sodio_split) #Asignamso lo q entrenaremos
sodio_test <- testing(sodio_split) #Asigna la evaluacion
# Declaramos un modelo Lineal
lr_sodio <- linear_reg() %>%
set_engine('lm') %>%
set_mode('regression')
# Ajustamos el modelo
lr_fit_sodio <- lr_sodio %>%
fit(contenido_calorico ~ ., data = sodio_train) #entranamos el modelo
print(lr_fit_sodio) parsnip model object
Call:
stats::lm(formula = contenido_calorico ~ ., data = data)
Coefficients:
(Intercept) sodio
175.98935 0.09063 En la siguiente seccion podemos apreciar un resumen rapido del modelo, este nso sirve para tener una diea previa de los resulatdos que obtuvimos
summary(lr_fit_sodio$fit) %>% print()
Call:
stats::lm(formula = contenido_calorico ~ ., data = data)
Residuals:
Min 1Q Median 3Q Max
-227.25 -72.17 -30.65 54.01 695.50
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 175.98935 10.84088 16.234 < 2e-16 ***
sodio 0.09063 0.01391 6.516 4.37e-10 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 139.8 on 234 degrees of freedom
Multiple R-squared: 0.1536, Adjusted R-squared: 0.15
F-statistic: 42.46 on 1 and 234 DF, p-value: 4.372e-10lr_results_sodio <- sodio_test %>%
select(contenido_calorico) %>%
mutate(predict(lr_fit_sodio, new_data = sodio_test)) %>%
mutate(respecto = "Sodio")
paged_table(lr_results_sodio, options = list(rows.print = 10))Evaluacion del mdoelo lineal de sodio
Las siguientes metrcias nos presentaran que tan bueno o que tan malo es el modelo
metricas_sodio <- metrics(lr_results_sodio, truth = contenido_calorico, estimate = .pred)
metricas_sodio %>% kable(digits = 3,
format.args = list(big.mark = ",")) #Lo mostramos en una tabla| .metric | .estimator | .estimate |
|---|---|---|
| rmse | standard | 208.101 |
| rsq | standard | 0.220 |
| mae | standard | 115.342 |
Metricas del modelo de sodio
Coeficiente de determinación (RSQ): Nos indica que tan bueno es un modelo de predicción con valores entre 1 y 0. Siendo 0 muy malo y 1 muy bueno. Es importante mencionar que cada vez que se ejecute el código fuente del presente informe, estos valores cambiarán debido a que R toma diferentes valores cada vez que se ejecuta el script.
Distancia media cuadrática mínima (RMSE): Nos indica que tan bueno es un modelo de predicción, con al diferencia que este se da en valores numéricos reales de 0 a cualquier número donde x = 0 .Donde 0 es mejor y mientras más se aleje el valor del cero, menor será su nivel de predicción.
grafica_sodio <- lr_results_sodio %>%
ggplot(aes(x = .pred, y = contenido_calorico))+
geom_point(alpha = 0.1)+
geom_abline(color = "darkred")
ggplotly(grafica_sodio)Grafica del modelo lineal de sodio
A continuación se realiza una comparación de los resultados de las regresiones lineales de cada variable respecto a las calorías, para esto realizaremos una comparación de gráficas para que de esta manera podamos apreciar visualmente cómo se comportan las variables de manera individual respecto al contenido calórico y cual puede llegar a aportar más a la distribución de las calorías en los alimentos.
comp <- bind_rows(lr_results_carbo, lr_results_prote, lr_results_lipidos, lr_results_sodio) %>%
ggplot(aes(x = .pred, y = contenido_calorico, color = respecto)) +
geom_point(alpha = 0.1) +
geom_abline(color = "darkred") +
facet_wrap(~ respecto) + #significa que voy a realizar facetas para cada modelo.
theme(legend.position = "none")
ggplotly(comp)Comparacion visual de las regresiones de cada variable
A continuación se presentan 4 modelos de predicción con diferentes algoritmos para realizar esta comprobación, el fin de hacer 4, es buscar qué modelo se ajusta mejor a nuestro datos para de esta manera tener predicciones más certeras usando el modelo mejor adaptado.
lr_model <- linear_reg() %>%
set_engine("lm") %>%
set_mode("regression")lr_workflow <- workflow() %>%
add_model(lr_model) %>%
add_recipe(receta) %>%
print()══ Workflow ════════════════════════════════════════════════════════════════════
Preprocessor: Recipe
Model: linear_reg()
── Preprocessor ────────────────────────────────────────────────────────────────
4 Recipe Steps
• step_other()
• step_nzv()
• step_dummy()
• step_normalize()
── Model ───────────────────────────────────────────────────────────────────────
Linear Regression Model Specification (regression)
Computational engine: lm lr_fit <- lr_workflow %>%
fit(nutri_train) %>%
print()══ Workflow [trained] ══════════════════════════════════════════════════════════
Preprocessor: Recipe
Model: linear_reg()
── Preprocessor ────────────────────────────────────────────────────────────────
4 Recipe Steps
• step_other()
• step_nzv()
• step_dummy()
• step_normalize()
── Model ───────────────────────────────────────────────────────────────────────
Call:
stats::lm(formula = ..y ~ ., data = data)
Coefficients:
(Intercept) carbohidratos proteinas lipidos sodio
228.38 102.19 28.85 85.04 26.72
alimento_other
71.33 lr_results <- ntru_test %>%
select(contenido_calorico) %>%
mutate(predict(lr_fit, new_data = ntru_test),
model = "linear regression")
paged_table(lr_results, options = list(rows.print = 10))Evaluacion del modelo de regresion lineal multiple
metricas <- metrics(lr_results, truth = contenido_calorico, estimate = .pred) %>%
mutate(model = "lineal regression")
paged_table(metricas)Evaluacion del modelo de regresion lineal multiple
grafica_lr <- lr_results %>%
ggplot(aes(x = .pred, y = contenido_calorico))+
geom_point(alpha = 0.1)+
geom_abline(color = "darkred")
ggplotly(grafica_lr)Grafico del modelo de regresion lineal
rf_model <- rand_forest() %>%
set_engine("ranger") %>%
set_mode("regression")rf_wf <- workflow() %>%
add_model(rf_model) %>%
add_recipe(receta) %>%
print()══ Workflow ════════════════════════════════════════════════════════════════════
Preprocessor: Recipe
Model: rand_forest()
── Preprocessor ────────────────────────────────────────────────────────────────
4 Recipe Steps
• step_other()
• step_nzv()
• step_dummy()
• step_normalize()
── Model ───────────────────────────────────────────────────────────────────────
Random Forest Model Specification (regression)
Computational engine: ranger rf_fit <- rf_wf %>%
fit(nutri_train) %>%
print()══ Workflow [trained] ══════════════════════════════════════════════════════════
Preprocessor: Recipe
Model: rand_forest()
── Preprocessor ────────────────────────────────────────────────────────────────
4 Recipe Steps
• step_other()
• step_nzv()
• step_dummy()
• step_normalize()
── Model ───────────────────────────────────────────────────────────────────────
Ranger result
Call:
ranger::ranger(x = maybe_data_frame(x), y = y, num.threads = 1, verbose = FALSE, seed = sample.int(10^5, 1))
Type: Regression
Number of trees: 500
Sample size: 234
Number of independent variables: 5
Mtry: 2
Target node size: 5
Variable importance mode: none
Splitrule: variance
OOB prediction error (MSE): 3237.755
R squared (OOB): 0.8974659 rf_results <- ntru_test %>%
select(contenido_calorico) %>%
mutate(predict(rf_fit, new_data = ntru_test),
model = "random forest")
paged_table(rf_results, options = list(rows.print = 10))rf_metrics <- metrics(rf_results, truth = contenido_calorico, estimate = .pred) %>%
mutate(model = "random forest")
paged_table(rf_metrics)Metrcias del modelo random forest
graf_RF <- rf_results %>%
ggplot(aes(x = .pred, y = contenido_calorico))+
geom_point(alpha = 0.1)+
geom_abline(color = "darkred")
ggplotly(graf_RF)Grafico del modelo Random Forest
kknn_model <- nearest_neighbor() %>%
set_engine("kknn") %>%
set_mode("regression")kknn_wf <- workflow() %>%
add_model(kknn_model) %>%
add_recipe(receta) %>%
print()══ Workflow ════════════════════════════════════════════════════════════════════
Preprocessor: Recipe
Model: nearest_neighbor()
── Preprocessor ────────────────────────────────────────────────────────────────
4 Recipe Steps
• step_other()
• step_nzv()
• step_dummy()
• step_normalize()
── Model ───────────────────────────────────────────────────────────────────────
K-Nearest Neighbor Model Specification (regression)
Computational engine: kknn kknn_fit <- kknn_wf %>%
fit(nutri_train) %>%
print()══ Workflow [trained] ══════════════════════════════════════════════════════════
Preprocessor: Recipe
Model: nearest_neighbor()
── Preprocessor ────────────────────────────────────────────────────────────────
4 Recipe Steps
• step_other()
• step_nzv()
• step_dummy()
• step_normalize()
── Model ───────────────────────────────────────────────────────────────────────
Call:
kknn::train.kknn(formula = ..y ~ ., data = data, ks = min_rows(5, data, 5))
Type of response variable: continuous
minimal mean absolute error: 19.9525
Minimal mean squared error: 4889.04
Best kernel: optimal
Best k: 5kknn_results <- ntru_test %>%
select(contenido_calorico) %>%
mutate(predict(kknn_fit, new_data = ntru_test),
model = "nearest neighbors")
paged_table(kknn_results, options = list(rows.print = 10))Evaluacion del modelo de Nearest Neighbours
kknn_metrics <- metrics(kknn_results, truth = contenido_calorico, estimate = .pred) %>%
mutate(model = "nearest neighbors")
paged_table(kknn_metrics)graf_KKNN <- kknn_results %>%
ggplot(aes(x = .pred, y = contenido_calorico))+
geom_point(alpha = 0.1)+
geom_abline(color = "darkred")
ggplotly(graf_KKNN)Grafico del modelo Neareast Neighbours
rgl_model <- linear_reg(penalty = 0.01, mixture = 0.5) %>%
set_engine("glmnet") %>%
set_mode("regression")rgl_wf <- workflow() %>%
add_model(rgl_model) %>%
add_recipe(receta) %>%
print()══ Workflow ════════════════════════════════════════════════════════════════════
Preprocessor: Recipe
Model: linear_reg()
── Preprocessor ────────────────────────────────────────────────────────────────
4 Recipe Steps
• step_other()
• step_nzv()
• step_dummy()
• step_normalize()
── Model ───────────────────────────────────────────────────────────────────────
Linear Regression Model Specification (regression)
Main Arguments:
penalty = 0.01
mixture = 0.5
Computational engine: glmnet rgl_fit <- rgl_wf %>%
fit(nutri_train) %>%
print()══ Workflow [trained] ══════════════════════════════════════════════════════════
Preprocessor: Recipe
Model: linear_reg()
── Preprocessor ────────────────────────────────────────────────────────────────
4 Recipe Steps
• step_other()
• step_nzv()
• step_dummy()
• step_normalize()
── Model ───────────────────────────────────────────────────────────────────────
Call: glmnet::glmnet(x = maybe_matrix(x), y = y, family = "gaussian", alpha = ~0.5)
Df %Dev Lambda
1 0 0.00 233.900
2 1 4.70 213.200
3 1 9.02 194.200
4 1 12.99 177.000
5 1 16.61 161.200
6 1 19.88 146.900
7 1 22.83 133.900
8 1 25.47 122.000
9 1 27.83 111.100
10 2 30.43 101.300
11 3 33.50 92.270
12 3 36.28 84.080
13 3 38.68 76.610
14 3 40.75 69.800
15 3 42.54 63.600
16 3 44.07 57.950
17 3 45.38 52.800
18 3 46.50 48.110
19 3 47.46 43.840
20 4 48.29 39.940
21 4 49.08 36.390
22 4 49.74 33.160
23 4 50.30 30.220
24 4 50.77 27.530
25 4 51.17 25.090
26 4 51.50 22.860
27 4 51.78 20.830
28 4 52.02 18.980
29 4 52.22 17.290
30 4 52.38 15.750
31 4 52.52 14.350
32 4 52.64 13.080
33 4 52.73 11.920
34 4 52.82 10.860
35 4 52.88 9.894
36 4 52.94 9.015
37 4 52.99 8.214
38 4 53.03 7.485
39 4 53.06 6.820
40 4 53.09 6.214
41 4 53.11 5.662
42 4 53.13 5.159
43 5 53.25 4.701
44 5 53.39 4.283
45 5 53.50 3.902
46 5 53.60 3.556
...
and 33 more lines.#|label: Evaluacion RLG
#| fig-cap: Evaluacion del modelo de Regresion Lineal Multiple Generalziada
#| warning: false
rgl_results <- ntru_test %>%
select(contenido_calorico) %>%
mutate(predict(rgl_fit, new_data = ntru_test),
model = "Generalized linear regression")
paged_table(rgl_results, options = list(rows.print = 10))rgl_metrics <- metrics(rgl_results, truth = contenido_calorico, estimate = .pred) %>%
mutate(model = "nearest neighbors")
paged_table(rgl_metrics)graf_rgl <- rgl_results %>%
ggplot(aes(x = .pred, y = contenido_calorico))+
geom_point(alpha = 0.1)+
geom_abline(color = "darkred")
ggplotly(graf_rgl)Grafico del modelo de Regresion Lineal Generalizada
A continuacion se presentan los modelos realziados para tener un mejor visualziacion al moemnto de comprarlos y determianr que modelos e ajusta mejor
comp_models <- bind_rows(lr_results, rf_results, kknn_results, rgl_results) %>%
ggplot(aes(x = .pred, y = contenido_calorico, color = model)) +
geom_point(alpha = 0.1) +
geom_abline(color = "darkred") +
facet_wrap(~ model) + #significa que voy a realizar facetas para cada modelo.
theme(legend.position = "none")
ggplotly(comp_models)Comparacion visual de los diferentes modelos de prediccion
Para este caso realizaremos una predicción con el modelo que creemos que mejor se ajuste al modelo, es importante mencionar que cada vez que se ejecuta el código fuente de este documento, los parámetros y resultados pueden cambiar, por lo que se recomienda analizar los datos sin modificar el archivo .QMD.
# NOTA: Las calorias de este alimento son 100
datos_prediccion <- tibble(
alimento = "Nutella",
carbohidratos = 11,
proteinas = 1,
lipidos = 6,
sodio = 10)
kable(datos_prediccion)| alimento | carbohidratos | proteinas | lipidos | sodio |
|---|---|---|---|---|
| Nutella | 11 | 1 | 6 | 10 |
Realizaremos 3 predicciones con los datos precargados con los diferentes modelos.
lr_fit %>%
predict(new_data = datos_prediccion) %>%
mutate(Rubro = "Calorias") %>%
kable()| .pred | Rubro |
|---|---|
| 123.1306 | Calorias |
rf_fit %>%
predict(new_data = datos_prediccion) %>%
mutate(Rubro = "Calorias") %>%
kable()| .pred | Rubro |
|---|---|
| 120.3833 | Calorias |
kknn_fit %>%
predict(new_data = datos_prediccion) %>%
mutate(Rubro = "Calorias") %>%
kable()| .pred | Rubro |
|---|---|
| 116 | Calorias |
rgl_fit %>%
predict(new_data = datos_prediccion) %>%
mutate(Rubro = "Calorias") %>%
kable()| .pred | Rubro |
|---|---|
| 123.0775 | Calorias |
# feature importance
lr_fit %>%
extract_fit_parsnip() %>%
vip::vip(aesthetics =list(alpha = 0.75,
fill = "darkgreen"))
Como podemos apreciar, utilizando el modelo de regresión lineal, nos indica que los carbohidratos son los datos que tienen una mayor importancia al momento de realizar predicciones sobre el contenido calórico de algún alimento.
Una vez realizado todo el análisis podemos determinar las siguientes conclusiones de los datos recabados.
Demostración:
1.1. Podemos observar desde la regresión lineal simple entre carbohidratos y contenido calórico, teniendo en general las mejores métricas en comparativa con los demás modelos entre las variables.
1.2. En el preprocesamiento nos indicó una alta correlación entre los carbohidratos y el contenido calórico.
1.3. Al momento de realizar la predicción y analizar la importancia que tuvo cada variable para la predicción de las calorías, claramente tenemos un alto porcentaje correspondientes a carbohidratos.
1.4. Al momento de realizar la regresión lineal de los macroalimentos y compararlos visualmente, nos damos cuenta que el modelo con mejor ajuste es el correspondiente a carbohidratos.
1.5. Al ver el top alimentos con más carbohidratos y compararlo con el top de contenido calórico, podemos apreciar que hay varios alimentos que coinciden que un alto contenido en carbohidratos, son altos también en contenido calórico.
Demostración
2.1 El modelo de Random Forest tiene una mayor precisión a comparación de los demás modelos, esto lo podemos apreciar en las métricas del modelo, teniendo las más satisfactorias en el Random Forest.
2.2. Al momento de realizar la comparación visual de los modelos para predicción, nos damos cuenta que Random Forest se acomoda bastante bien a todos los datos para realizar predicciones, teniendo poca variación en los datos.
2.3. Al momento de realizar la predicción con un alimento al que ya conocemos sus calorías, nos damos cuenta que el modelo de Random Forest logra la mejor predicción al valor que los demás modelos.